home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / tclx7.5a- / tclx7 / usr / local / bin / tclhelp < prev    next >
Encoding:
Tcl/Tk script  |  1995-11-14  |  9.7 KB  |  331 lines
  1. #!/usr/local/bin/wishx
  2.  
  3. # tclhelp.tcl --
  4. #
  5. # Tk program to access Extended Tcl & Tk help pages.  Uses internal functions
  6. # of TclX help command.
  7. # 
  8. #------------------------------------------------------------------------------
  9. # Copyright 1993-1995 Karl Lehenbauer and Mark Diekhans.
  10. #
  11. # Permission to use, copy, modify, and distribute this software and its
  12. # documentation for any purpose and without fee is hereby granted, provided
  13. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14. # Mark Diekhans make no representations about the suitability of this
  15. # software for any purpose.  It is provided "as is" without express or
  16. # implied warranty.
  17. #------------------------------------------------------------------------------
  18. # $Id: tclhelp.tcl,v 5.0 1995/07/25 06:00:36 markd Rel $
  19. #------------------------------------------------------------------------------
  20.  
  21. #------------------------------------------------------------------------------
  22. # Add a button associated with either a file or directory in the help tree.
  23. # This handles creating frames to hold each row of buttons.  Buttons should
  24. # be delivered in accending row order, and accending column order within each
  25. # row.  Special handling is done for '..'/
  26.  
  27. proc AddButton {parent subject fileName row col} {
  28.  
  29.     # Prep name to use in button and other file info.
  30.  
  31.     set isDir [string match */ $fileName]
  32.     if [string match */ $subject] {
  33.         set subject [csubstr $subject 0 len-1]
  34.     }
  35.     if {$fileName == ".."} {
  36.         set fileName "<Up>"
  37.         set filePath [file dirname $subject]
  38.         set isDir 1
  39.     } else {
  40.         set filePath ${subject}/${fileName}
  41.     }
  42.  
  43.     # Set up a row frame, if needed.
  44.  
  45.     set nframe $parent.row$row
  46.     if {$col == 0} {
  47.         frame $nframe
  48.         pack $nframe -side top -expand 1 -anchor w -fill x
  49.     }
  50.  
  51.     # Set up the button.
  52.  
  53.     set buttonName $nframe.col$col
  54.     if $isDir {
  55.         button $buttonName -text $fileName -width 20 \
  56.             -command "DisplaySubject $filePath"
  57.     } else {
  58.         button $buttonName -text $fileName -width 20 \
  59.             -command "DisplayPage $filePath"
  60.     }
  61.     pack $buttonName -side left -anchor w
  62. }
  63.  
  64. #------------------------------------------------------------------------------
  65. # Create a frame to hold buttons for the specified list of either help files
  66. # or directories.
  67.  
  68. proc ButtonFrame {w title subject fileList} {
  69.     frame $w
  70.     label $w.label -relief flat -text $title -background SlateGray1
  71.     pack $w.label -side top -fill both
  72.     frame $w.buttons
  73.     pack $w.buttons -side top -expand 1 -anchor w
  74.     set col 0
  75.     set row 0
  76.     while {![lempty $fileList]} {
  77.         AddButton $w.buttons $subject [lvarpop fileList] $row $col
  78.         if {[incr col] >= 5} {
  79.             incr row
  80.             set col 0
  81.         }
  82.     }
  83. }
  84.  
  85. #------------------------------------------------------------------------------
  86. # Display the panels contain the subjects (directories) and the help files for
  87. # a given directory.
  88.  
  89. proc DisplaySubject {subject} {
  90.  
  91.     help:ListSubject $subject [help:ConvertPath $subject] subjects pages
  92.     if {$subject != "/"} {
  93.         lvarpush subjects ".."
  94.     }
  95.  
  96.     # Allow us to resize if the user has set the size.
  97.     wm geometry . ""
  98.  
  99.     set frame .tkhelp.pick
  100.     catch {destroy $frame}
  101.     frame $frame
  102.     pack $frame -side top -fill x
  103.     
  104.     ButtonFrame $frame.subjects "Subjects available in $subject" \
  105.         $subject $subjects
  106.     pack $frame.subjects -side top -fill x
  107.  
  108.     ButtonFrame $frame.pages "Help files available in $subject" \
  109.         $subject $pages
  110.     pack $frame.pages -side top -fill x
  111. }
  112.  
  113. #------------------------------------------------------------------------------
  114. # Display a file in a top-level text window.
  115.  
  116. proc DisplayPage {page} {
  117.     set fileName [file tail $page]
  118.  
  119.     set w ".tkhelp-[translit "." "_" $page]"
  120.  
  121.     if [winfo exists $w] {
  122.         destroy $w
  123.     }
  124.     toplevel $w
  125.  
  126.     wm title $w "Help on '$page'"
  127.     wm iconname $w "Help: $page"
  128.     wm minsize $w 1 1
  129.     frame $w.frame -borderwidth 10
  130.  
  131.     scrollbar $w.frame.yscroll -relief sunken \
  132.         -command "$w.frame.page yview"
  133.     text $w.frame.page -yscrollcommand "$w.frame.yscroll set" \
  134.         -width 80 -height 20 -relief sunken -wrap word
  135.     pack $w.frame.yscroll -side right -fill y
  136.     pack $w.frame.page -side top -expand 1 -fill both
  137.  
  138.     if [catch {
  139.             set contents [read_file [help:ConvertPath $page]]
  140.         } msg] {
  141.         set contents $msg
  142.     }
  143.     $w.frame.page insert 0.0 $contents
  144.     $w.frame.page configure -state disabled
  145.  
  146.     button $w.dismiss -text Dismiss -command "destroy $w"
  147.     pack $w.dismiss -side bottom -fill x
  148.     pack $w.frame -side top -fill both -expand 1
  149. }
  150.  
  151. #------------------------------------------------------------------------------
  152. # Set up the apropos panel.
  153.  
  154. proc AproposPanel {} {
  155.     global aproposEntryNumber aproposReferenceFrame referenceFrameItem
  156.  
  157.     set aproposEntryNumber 0
  158.  
  159.     if [winfo exists .apropos] {
  160.         destroy .apropos
  161.     }
  162.     toplevel .apropos
  163.     wm minsize .apropos 1 1
  164.  
  165.     # put in the dismiss button
  166.     set w .apropos.buttonFrame
  167.     frame $w
  168.     pack $w -side bottom -fill x
  169.     button $w.dismiss -text Dismiss -command "destroy .apropos"
  170.     pack $w.dismiss -side bottom -fill x
  171.  
  172.     frame .apropos.entryFrame
  173.     pack .apropos.entryFrame -side top -fill x
  174.  
  175.     label .apropos.entryFrame.label -text "Search for"
  176.     pack .apropos.entryFrame.label -side left
  177.  
  178.     entry .apropos.entryFrame.entry -relief sunken
  179.     pack .apropos.entryFrame.entry -side left -fill x -expand 1
  180.  
  181.     bind .apropos.entryFrame.entry <Return> PerformAproposSearch
  182.  
  183.     frame .apropos.canvasFrame
  184.     set w .apropos.canvasFrame
  185.  
  186.     canvas $w.canvas -yscrollcommand "$w.yscroll set" \
  187.             -xscrollcommand "$w.xscroll set" \
  188.             -width 15c -height 5c -relief sunken
  189.  
  190.     scrollbar $w.yscroll -relief sunken \
  191.         -command "$w.canvas yview"
  192.  
  193.     scrollbar $w.xscroll -relief sunken -orient horiz \
  194.         -command "$w.canvas xview"
  195.  
  196.     pack $w.xscroll -side bottom -fill x
  197.     pack $w.yscroll -side right -fill y
  198.     pack $w.canvas -in $w -expand yes -fill both
  199.     pack $w -side bottom -expand yes -fill both
  200.  
  201.     # Allow input without Button1 press.
  202.     focus .apropos.entryFrame.entry
  203.     update idletasks
  204. }
  205.  
  206. #---------------------------------------------------------------------------
  207. #put a line in the reference display for this apropos entry we've discovered
  208. #
  209. proc DisplayAproposReference {path description} {
  210.     global aproposEntryNumber aproposReferenceFrame
  211.  
  212.     set frame $aproposReferenceFrame.e$aproposEntryNumber
  213.     frame $frame
  214.     pack $frame -side top -anchor w
  215.  
  216.     button $frame.button -text $path -width 30 \
  217.         -command "DisplayPage /$path"
  218.     pack $frame.button -side left
  219.  
  220.     label $frame.label -text $description
  221.     pack $frame.label -side left
  222.  
  223.     incr aproposEntryNumber
  224. }
  225.  
  226. #---------------------------------------------------------------------------
  227. #the actual search is cadged from "apropos" in the tclx help system
  228. #
  229. proc PerformAproposSearch {} {
  230.     global TCLXENV referenceFrameItem aproposEntryNumber aproposReferenceFrame
  231.  
  232.     # Get expression, ignore if empty
  233.     set regexp [.apropos.entryFrame.entry get]
  234.     if ![clength $regexp] {
  235.         return
  236.     }
  237.  
  238.     #  start variables and clean up any residue from previous searches
  239.     set w .apropos.canvasFrame
  240.     set aproposEntryNumber 0
  241.     .apropos.canvasFrame.canvas delete all
  242.     set aproposReferenceFrame $w.canvas.frame
  243.     catch {destroy $aproposReferenceFrame}
  244.     catch {destroy .apropos.canvasFrame.failed}
  245.  
  246.     # create the frame we'll pack matches into and put it into the canvas
  247.     frame $aproposReferenceFrame
  248.     set referenceFrameItem \
  249.         [$w.canvas create window 2 2 -window $aproposReferenceFrame -anchor nw]
  250.  
  251.     set TCLXENV(help:lineCnt) 0
  252.  
  253.     # set up scan context
  254.     set ch [scancontext create]
  255.     scanmatch -nocase $ch $regexp {
  256.         set path [lindex $matchInfo(line) 0]
  257.         set desc [lrange $matchInfo(line) 1 end]
  258.         DisplayAproposReference $path $desc
  259.     }
  260.  
  261.     # perform search
  262.     foreach dir [help:RootDirs] {
  263.         foreach brief [glob -nocomplain $dir/*.brf] {
  264.             set briefFH [open $brief]
  265.             scanfile $ch $briefFH
  266.             close $briefFH
  267.         }
  268.     }
  269.  
  270.     # delete scan context
  271.     scancontext delete $ch
  272.  
  273.     # force display to update so we can find out our bounding box
  274.     update
  275.  
  276.     # if nothing matched, complain
  277.     if {$aproposEntryNumber == 0} {
  278.         label $aproposReferenceFrame.failed -text "NOTHING MATCHED."
  279.         pack $aproposReferenceFrame.failed -side left
  280.     }
  281.  
  282.     # set the canvas scrollregion to the size of the bounding box
  283.     lassign [.apropos.canvasFrame.canvas bbox $referenceFrameItem] \
  284.         dummy dummy xSize ySize
  285.     .apropos.canvasFrame.canvas configure -scrollregion \
  286.     "0 0 $xSize $ySize"
  287. }
  288.  
  289. #------------------------------------------------------------------------------
  290. # Set up the command buttons.
  291.  
  292. proc CreateCommandButtons {frameName} {
  293.     frame $frameName
  294.  
  295.     button $frameName.quit -text "Quit" -command exit
  296.     pack $frameName.quit -side left
  297.  
  298.     button $frameName.apropos -text "Apropos" -command AproposPanel
  299.     pack $frameName.apropos -side left
  300. }
  301.  
  302. #------------------------------------------------------------------------------
  303. # Tk base help command for Tcl/Tk/TclX.  Directories in args are pushed on the
  304. # path so that they are included in help search.
  305.  
  306. proc tkhelp addPaths {
  307.     global auto_path
  308.     if ![auto_load help] {
  309.         puts stderr "couldn't auto_load TclX 'help' command"
  310.         exit 255
  311.     }
  312.     foreach dir $addPaths {
  313.         lvarpush auto_path $dir
  314.     }
  315.     CreateCommandButtons .command
  316.     pack .command -side top -fill x
  317.  
  318.     frame .tkhelp
  319.     pack .tkhelp -side top -fill both
  320.  
  321.     DisplaySubject "/"
  322.  
  323. }
  324.  
  325. if [catch {
  326.     tkhelp $argv
  327. } msg] {
  328.     tkerror $msg
  329. }
  330.  
  331.